Gigarom 4/Mac Giga-ROM 4.0 - 1993.toast/FILES/DEV/I-Z/ViewIt™ Shareware.sea/ViewIt™ 2.04 Shareware/Projects/Fortran Demos/vDemoAF.f

Text File | 1992-08-04 | 5KB | 152 lines

C NOTE: Read the "MPW Fortrans" section of "About Compilers"
C before compiling AF programs that use FaceWare modules.

C ViewIt 2.03 Demonstration Program
C ©FaceWare 1991-92.  All Rights Reserved.

    GLOBAL DEFINE
    include "Types.inc"
    include "QuickDraw.inc"
    include "Controls.inc"
    include "Events.inc"
    include "OSUtils.inc"
    include "OSEvents.inc"
    include "SegLoad.inc"
    include "Files.inc"
    include "Resources.inc"
    include "FaceStorAF.inc"
    structure /DataRec/
      integer*2 myInteger
      real*4 myReal
      character*100 myString
      integer*4 myFlags
    end structure
    END

    include "FaceProcAF.inc"

      PROGRAM vDemoAF
    implicit none
      record /FaceRec/ fRec
      common/FaceStuff/fRec
    record/DataRec/myRec
    common/MyStuff/myRec
    real*4 theReal
    logical*4 helpShown
    integer*4 myPtr
    integer*4 OverProc
    pascal external OverProc

    myRec.myInteger = 0
    myRec.myReal = 6.2
    myRec.myString = 'Hello'
    myRec.myFlags = 10
    theReal = 6.0

C Initialize FaceIt
      fRec.uName = 'vDemo.Rsrc'
      call FaceIt(0,DoInit,0,0,0,0)

C Show ViewIt On-Line Help (if available)
    call FaceIt(0,HlpWnd,0,0,10,10)

C Open Modeless Window using FWND 1000
    call FaceIt(0,NewWnd,1000,1,0,0)

      do while (.true.)
        call FaceIt(0,DoLoop,0,0,0,0)
C Standard "About" Menu Item Selection
      if ((fRec.uMenuID == 101).and.(fRec.uMenuItem == 1)) then
        fRec.uString = 'Demonstration of the use of ViewIt'
     +//char(13)//'windows in a FaceIt-based program.'
        call FaceIt(0,ShoStr,3,12,(1 + (409*65536)),0)
C Hit in Modeless Window's "Open Modal" Button
      else if ((fRec.uMenuID == 1000).and.(fRec.wcHit == 2)) then
        call FaceIt(0,NewWnd,1001,0,0,0)  !Open Modal Window
        do while (.true.)
          call FaceIt(0,MdlWnd,1001,0,0,0)  !Process Modal Events
        if (fRec.wcHit == -1) then        !Hit in Close Box
          exit
        else if (fRec.wcHit == 1) then    !Hit in "Open Nested"
          myPtr = %loc(myRec)
          call FaceIt(0,NewWnd,1002,0,0,myPtr)!Open Nested Modal
          call FaceIt(0,GetCtl,1002,0,2,3)      !Setup Override Examples
          call FaceIt(0,OvrCtl,fRec.cControl,OverProc,0,0)
          call FaceIt(0,GetCtl,1002,0,2,6)
          call FaceIt(0,OvrCtl,fRec.cControl,OverProc,0,0)
          call FaceIt(0,GetCtl,1002,0,2,7)
          call FaceIt(0,OvrCtl,fRec.cControl,OverProc,0,0)
          call FaceIt(0,SetVal,1002,0,0,0)      !Set Linked Values
          helpShown = .false.
          do while (.true.)
            call FaceIt(0,MdlWnd,1002,0,0,0)  !Process Modal Events
            if (fRec.wvHit == 1) then          !Hit in View #1
              if (fRec.wcHit == 1) then      !Hit in "OK" Button
              exit
            else if (fRec.wcHit == 2) then  !Hit in "Show/Hide"
              if (helpShown) then
                call FaceIt(0,ShoCtl,0,0,-3,2)  !Hide v3, Show v2
                helpShown = .false.
              else
                call FaceIt(0,ShoCtl,0,0,-2,3)  !Hide v2, Show v3
                helpShown = .true.
              end if
            end if
            end if
          end do
          call FaceIt(0,GetVal,1002,0,0,0)      !Get Linked Values
          call FaceIt(0,EndWnd,1002,0,0,0)      !Close Nested Modal
        end if
        end do
        call FaceIt(0,EndWnd,1001,0,0,0)  !Close Modal Window
C Hit in Modeless Window's "Why ViewIt?" Button
      else if ((fRec.uMenuID == 1000).and.(fRec.wcHit == 3)) then
        call FaceIt(0,NewWnd,1003,0,0,%loc(theReal))
        call FaceIt(0,SetVal,1003,0,0,0)
        do while (.true.)
          call FaceIt(0,MdlWnd,1003,0,0,0)
        if (fRec.wcHit == 1) exit
        end do
        call FaceIt(0,GetVal,1003,0,0,0)
        call FaceIt(0,EndWnd,1003,0,0,0)
      end if
      end do
      end

C NOTE: Use of a procedure like "OverProc" that is called by ViewIt
C requires that it be compiled with the "-k" option set.  See your
C MacFortran II manual for more info about the "-k" compiler option.
    PASCAL SUBROUTINE OverProc(thePtr)
    value thePtr
    implicit none
    integer*4 JumpIt
    inline (JumpIt = /z'2257',z'2051',z'4e90'/)
      record /FaceRec/ fRec
      common/FaceStuff/fRec
    record/DataRec/myRec
    common/MyStuff/myRec
    integer*4 thePtr,theArrow
    real*4 delta
    if (fRec.cResID == 1000) then     !Arrow Controls
      if (fRec.uCommand == 8) then    !mouse down message?
        delta = 0.001 * (fRec.cMin - 2)
        theArrow = fRec.cControl
        call HiliteControl(%val4(theArrow),%val2(1))
        do while (StillDown())
          myRec.myReal = myRec.myReal + delta
        call FaceIt(0,SetVal,0,0,2,2)
        call Delay(%val4(5),fRec.uI4)
        end do
        call HiliteControl(%val4(theArrow),%val2(0))
        return
      end if
    else                        !Editable Text Item
      if (fRec.uCommand == 264) then    !a key down message?
        if (fRec.uParam(1) == 32) then    !SPACE key pressed?
          fRec.uParam(1) = 95        !convert to UNDERLINE
        end if
      end if
    end if
    call JumpIt(%val4(thePtr))        !pass message to driver
    end